home *** CD-ROM | disk | FTP | other *** search
/ Aminet 19 / Aminet 19 (1997)(GTI - Schatztruhe)[!][Jun 1997].iso / Aminet / comm / cnet / cnet_toolkit.lha / CNet_ToolKit.REXX! < prev    next >
Text File  |  1997-04-05  |  78KB  |  1,779 lines

  1. ****************************************************************************
  2.      CNet ARexx Tool Kit, v3.00 by DOTORAN - For CNet v4.26b & v3.05c!
  3.  
  4.           A Collection of Useful ARexx SubRoutines & Procedures!
  5.  
  6.            Please use ANY of these in your OWN ARexx Creations!
  7.  
  8.      $VER: CNet ARexx Tool Kit, v3.00 (5-Apr-97) Compiled by Dotoran!
  9. ****************************************************************************
  10.  
  11. CONTENTS:
  12.  
  13.         [01] : From "Expanded" date to "Sorted" or "Internal" date format.
  14.         [02] : From x5xxxxx GU Value to "Sorted" or "Internal" date format.
  15.         [03] : From "Sorted" or "Internal" date to "Expanded" date format.
  16.         [04] : Numeric Range Parser: [ -2 19- 4 7-9 11.13.15,17 ]
  17.         [05] : CNet-like input routine, using MCI.
  18.         [06] : Find and return BBSTEXT/BBSMENU line entry.
  19. *       [07] : Check the CNet Amiga Version file is being run under.
  20. U       [08] : Check if a user is Suboperator in current subboard.
  21. U       [09] : Checks if MCI is enabled in current subboard.
  22. F       [10] : Convert from 12/24 hour time format to 12/24/min format.
  23.         [11] : External Library Loader
  24. U       [12] : View, Enable, Disable or Toggle "Priviledge" Flags.
  25.         [13] : Get "Arguments" from last command.
  26.         [14] : Read "Cursor Key" / "Return/Enter" Keyboard Input.
  27.         [15] : Convert "UPPERCASE" to "lowercase" text.
  28.         [16] : Pauses output for "x" number of seconds the RIGHT way!
  29.         [17] : Checks for "Loss of Carrier" in your Pfiles!
  30.         [18] : An informative "Error Checking" routine.
  31.         [19] : Positions cursor for printing anywhere on the screen.
  32.         [20] : Horizontal Text Scroller Number 1.
  33.         [21] : Horizontal Text Scroller Number 2.
  34.         [22] : Read the joystick(s) and firebutton(s).
  35.         [23] : First attempt at MOUSE capability. (95% Complete!)
  36.         [24] : Disable or Enable the MORE? prompt, regardless of setting!
  37.         [25] : Muffle ALL ports, regardless of setting!
  38.         [26] : Extended SelectFile Routine.
  39.         [27] : Add line of text to specified LOG file.
  40. U       [28] : Check Port Menu(s) Checkmark Status.
  41. U       [29] : Send Text File as CNet MAIL to specified User.
  42. *       [30] : Send a CNet/4 "File Attach" EMail Message to specified User.
  43. U       [31] : Send a System OLM (OnLine Message) to the current user.
  44.         [32] : Add keystrokes to other ports from present port.
  45.         [33] : A QUICK "Who" for SysOps, listing Access Group Number.
  46.         [34] : View "port" log of specified port. (Pre "calls" log).
  47.         [35] : Send Line Noise to a port (Ability to kick them off too!)
  48.         [36] : UnLock User Accounts (That May NOT Have Been Previously!)
  49.         [37] : Replace <input> with <output> within string of <text>.
  50. E       [38] : Find and Return or Verify BBSMENU section line(s).
  51. E       [39] : Clears a specific port, by dumping the user.
  52.         [40] : EnCode & DeCode text strings, using a Numeric Key.
  53. *       [41] : Guideline Entry-text for Mail (and File) Subboards.
  54. *       [42] : NewDoor starter framework for New ARexx Doors/Pfiles.
  55.  
  56. * = New routines to this version of the CNet Amiga ToolKit, v3.00.
  57. F = Fixed routine since the last time.
  58. U = Updated routine since the last time.
  59. E = Expanded Ability & Updated since last time.
  60.  
  61. ****************************************************************************
  62.  
  63. /**[01]*********************************************************************
  64.  *
  65.  * Description: From "Expanded" date to "Sorted" or "Internal" date format.
  66.  *
  67.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  68.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  69.  *
  70.  ***************************************************************************
  71.  *
  72.  *    Expanded: Sun 25-Dec-1993 11:53a
  73.  *      Sorted: 19970330    (In YYYYMMDD Format)
  74.  *    Internal: 7028        (# of Days since 1/1/78)
  75.  *
  76.  *       Usage: <var>=SDATE(<date>,[mode])
  77.  *
  78.  *       Where: <date>  holds an "Expanded" Date.
  79.  *              [mode]  as "i" returns Internal Days Format.
  80.  *                      (Number of days since January 1, 1978)
  81.  *
  82.  *     Returns: <var>   holds the sorted (or internal) date format.
  83.  *
  84.  *      Note 1: Because of the way the internal ARexx DATE() command works,
  85.  *              you should NOT use dates PREVIOUS to January 1, 1978 when
  86.  *              using the "i" (internal) setting. This routine will, however
  87.  *              return the SORTED date for ANY DATE given.
  88.  *
  89.  *      Note 2: We decided to keep the "i" parameter, because it's a FAST
  90.  *              way to perform MATH functions on dates(13 days ago, etc).
  91.  */
  92.  
  93. getuser 1500000 ; d1=result ; d2=SDATE(d1) ; d3=SDATE(d1,"i")
  94. transmit "Expanded Date: "d1
  95. transmit "  Sorted Date: "d2
  96. transmit "Internal Days: "d3
  97. exit
  98.  
  99. SDATE: procedure;arg da,mo
  100.   da=substr(da,12,4)right(index("ANEBARPRAYUNULUGEPCTOVEC",substr(da,9,2))%2+1,2,"0")right(strip(substr(da,5,2)),2,"0")
  101.   if mo="I" then return date("i",da,"s")
  102.  return da
  103.  
  104. /**[02]*********************************************************************
  105.  *
  106.  * Description: From x5xxxxx GU Value to "Sorted" or "Internal" date format.
  107.  *
  108.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  109.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  110.  *
  111.  ***************************************************************************
  112.  *
  113.  *     x5xxxxx: 1500000, 1500410, 2500990, etc.
  114.  *
  115.  *      Sorted: 19970330    (In YYYYMMDD Format)
  116.  *
  117.  *    Internal: 7028        (# of Days since 1/1/78)
  118.  *
  119.  *       Usage: <var>=GDATE(<value>,[mode])
  120.  *
  121.  *       Where: <value> holds the 7-Digit x5xxxxx GetUser Value.
  122.  *              [mode]  as "i" returns Internal Days Format.
  123.  *                      (Number of days since January 1, 1978)
  124.  *
  125.  *     Returns: <var>   holds the sorted (or internal) date format.
  126.  *
  127.  *      Note 1: Because of the way the internal ARexx DATE() command works,
  128.  *              you should NOT use dates PREVIOUS to January 1, 1978 when
  129.  *              using the "i" (internal) setting. This routine will, however
  130.  *              return the SORTED date for ANY DATE given.
  131.  *
  132.  *      Note 2: We decided to keep the "i" parameter, because it's a FAST
  133.  *              way to perform MATH functions on dates(13 days ago, etc).
  134.  *
  135.  *       Fixed: The usage template above stated SDATE, instead of GDATE.
  136.  *              The GDATE routine used an UPPERCASE month template, which
  137.  *              returned incorrect month numerations, because LOWERCASE
  138.  *              characters are returned when reading DATE GetUsers.
  139.  */
  140.  
  141. getuser 1500416;a=result;transmit "Expanded 1st Call Date: "a
  142. d1=GDATE(1500416);transmit "  Sorted 1st Call Date: "d1
  143. d2=GDATE(1500416,"i");transmit "Internal 1st Call Date: "d2
  144. exit
  145.  
  146. GDATE: procedure;arg da,mo;getuser da;da=result
  147.   da=substr(da,12,4)right(index("anebarprayunulugepctovec",substr(da,9,2))%2+1,2,"0")right(strip(substr(da,5,2)),2,"0")
  148.   if mo="I" then return date("i",da,"s")
  149.  return da
  150.  
  151. /**[03]*********************************************************************
  152.  *
  153.  * Description: From "Sorted" or "Internal" date to "Expanded" date format.
  154.  *
  155.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  156.  *
  157.  ***************************************************************************
  158.  *
  159.  *      Sorted: 19970330        (In YYYYMMDD Format)
  160.  *    Internal: 7028            (# of Days since 1/1/78)
  161.  *    Expanded: Sun 30-Mar-1997 (No time format!)
  162.  *
  163.  *       Usage: <var>=EDATE(<date>,[mode])
  164.  *
  165.  *       Where: <date>  holds a "Sorted" or "Internal" Date.
  166.  *              [mode]  Specified as 'i' if <date> supplied is in
  167.  *                      Internal Days Format.
  168.  *                      (Number of days since January 1, 1978)
  169.  *
  170.  *     Returns: <var>   holds the expanded date format.
  171.  *
  172.  *      Note 1: Because of the way the internal ARexx DATE() command works,
  173.  *              you should NOT use dates PREVIOUS to January 1, 1978 when
  174.  *              using the "i" (internal) setting. This routine will, however
  175.  *              return the SORTED date for ANY DATE given.
  176.  *
  177.  *      Note 2: We decided to keep the "i" parameter, because it's a FAST
  178.  *              way to perform MATH functions on dates(13 days ago, etc).
  179.  */
  180.  
  181. d1="19970330" ; d2=EDATE(d1) ; d3="7028" ; d4=EDATE(d3,"i")
  182.  
  183. transmit "  Sorted Date: "d1" = Expanded Date: "d2
  184. transmit "Internal Days: "d3"     = Expanded Date: "d4
  185. exit
  186.  
  187. EDATE: procedure;arg da,mo;if mo="I" then da=date("s",da,"i")
  188.   return left(date("w",da,"s"),3)right("  "strip(translate(date("n",da,"s"),"-"," "),"L","0"),12)
  189.  
  190. /**[04]*********************************************************************
  191.  *
  192.  * Description: Numeric Range Parser: [ -2 19- 4 7-9 11.13.15,17 ]
  193.  *
  194.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  195.  *              PMK             - (Peter no longer runs a bbs...)
  196.  *
  197.  ***************************************************************************
  198.  *
  199.  *       Usage: <var>=PARSE(<range>,<min>,<max>,[sort])
  200.  *
  201.  *       Where: <var>    is any Legal Variable Name.
  202.  *              <range>  is the Numeric Range to Parse.
  203.  *              <min>    is the Minimum Value to Use.
  204.  *              <max>    is the Maximum Value to Use.
  205.  *              [sort]   as "s" is OPTIONAL. If specified, the items will
  206.  *                       also be Numerically Sorted. Duplicate Item checking
  207.  *                       is ONLY performed on SORTED item lists.
  208.  *
  209.  *     Returns: <var>    total parsed items.
  210.  *              <it.0>   parsed item string, parsed in SPACES.
  211.  *              <it.1>
  212.  *                 |
  213.  *              <it.?>   the individual parsed item array.
  214.  *
  215.  *      Note 1: This routine functions EXACTLY like CNet's own routine.
  216.  *              Open ended ranges( -5 or 12- ) fully supported. Any use
  217.  *              of DUPLICATE item numbers are removed, and the resulting
  218.  *              it.? array contains items in NUMERICAL Order. All Non-
  219.  *              Numeric items are discarded. Use the "it.0" variable
  220.  *              string in conjunction with the INDEX() command for VERY
  221.  *              FAST verification checking!
  222.  *
  223.  *      Note 2: If sorting is NOT essential to your needs in a particular
  224.  *              application, we suggest NOT using it, as it will speed up
  225.  *              the parsing process CONSIDERABLY! (VERY, VERY QUICK!)
  226.  */
  227.  
  228. transmit ">4Minimum: 0n1>4Maximum: 25n1>7Sort: ONn1"
  229. transmit " An Example: -2 19- 4 7-9 11.13.15,17n1"
  230. query "Enter Range: " ; tot=PARSE(result,0,25,"s")
  231. transmit 'n1 ARexx Code: result="'result'"'
  232. transmit "Ctot=PARSE(result,0,25,'s')n1"
  233. transmit "Total Items: "tot ; transmit "Parsed Data: "it.0
  234. do i=1 to tot ; transmit "  Item # "right(i,2)": "it.i ; end i
  235. exit
  236.  
  237. PARSE: procedure expose it.; arg rng,min,max,srt
  238.   it.="";c=0;it=translate(rng,"  ",".,")
  239.   do a=1 to words(it);c=c+1;it.c=word(it,a)
  240.     if index(it.c,"-")>0 then do;parse var it.c x"-"y
  241.     if y="" then y=max;if x="" then x=min
  242.     if x>y then do;d=x;x=y;y=d;end
  243.     if x<min|y>max|~datatype(x,"W")|~datatype(y,"W") then do;c=c-1;iterate;end
  244.     do b=x to y;it.c=b;c=c+1;end;c=c-1;end
  245.   else if it.c<min|it.c>max|~datatype(it.c,"W") then do;c=c-1;iterate;end;end
  246.  
  247. /* Leave the following SORT routine OUT if you plan on NEVER Sorting!     */
  248.  
  249.   if c>0 & upper(arg(4))="S" then do;do a=1 to c-1;d=a;do b=a+1 to c;d=d+1
  250.     if it.d<it.a then do;y=it.a;it.a=it.d;it.d=y;end
  251.     else if it.d=it.a then do;it.d=it.c;c=c-1;d=d-1;end;end;end;end;a=0
  252.   do i=1 to c;j=i+1;if it.i~=it.j then do;a=a+1;it.a=it.i;end;end;c=a
  253.  
  254. /* This code MUST APPEAR, whether you use the above SORT routine or NOT!  */
  255.  
  256.   do i=1 to c;it.0=it.0||it.i" ";end
  257.  return c
  258.  
  259. /**[05]*********************************************************************
  260.  *
  261.  * Description: CNet-like input routine, using MCI.
  262.  *
  263.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  264.  *
  265.  ***************************************************************************
  266.  *
  267.  *       Usage: <var>=INPUT(<text>,<length>,<MCI opt>,[default])
  268.  *
  269.  *       Where: <text>     holds the prompt text.
  270.  *              <length>   holds the max length of the input.
  271.  *              <MCI opt>  MCI input options (1=caps, 2=filename, etc.)
  272.  *                         (Review the MCI {I } Command for more info!)
  273.  *              [default]  holds the default text to appear under the
  274.  *                         cursor in the prompt.(OPTIONAL)
  275.  *
  276.  *     Returns: <var>      holds data that was input.
  277.  */
  278.  
  279. getuser 3 ; a=INPUT("n1Who are you?n1:",20,128,result)
  280. transmit "n1Answer="a ; exit
  281.  
  282. INPUT:;transmit arg(1)" L1305640 #"arg(4)"}I"arg(3)+4" "arg(2)"}"
  283.   getuser 70;return result
  284.  
  285. /**[06]*********************************************************************
  286.  *
  287.  * Description: Find and return BBSTEXT/BBSMENU line entry.
  288.  *
  289.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  290.  *
  291.  ***************************************************************************
  292.  *
  293.  *       Usage: <var>=BBSLINE(<file>,<line>)
  294.  *
  295.  *       Where: <file>    which file to use. (0=BBSMENU, 1=BBSTEXT)
  296.  *              <line>    holds the line number in BBSTEXT/BBSMENU.
  297.  *
  298.  *     Returns: <var>     holds the returned BBSTEXT/BBSMENU line entry.
  299.  */
  300.  
  301. send bbsline(1,4) ; transmit " : line 4 in BBSTEXT"
  302. send bbsline(0,7) ; transmit "  : line 7 in BBSMENU"
  303. exit
  304.  
  305. BBSLINE: procedure;arg ty,li;getuser 1402018+(ty*4)
  306.   ln=import(import(offset(x2c(d2x(result,8)),(li-1)*4),4),1024)
  307.   parse var ln ln"00"x .;return ln
  308.  
  309. /**[07]*********************************************************************
  310.  *
  311.  * Description: Check the CNet Amiga Version file is being run under.
  312.  *
  313.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  314.  *
  315.  ***************************************************************************
  316.  *
  317.  *       Usage: <var>=CHECKVER()
  318.  *
  319.  *     Returns: <var> holds "3" if running under CNet Amiga, v3.05c,
  320.  *                    holds "4" if running under CNet Amiga, v4.26b+.
  321.  *
  322.  *      Option: <var>=CHECKVER()-3
  323.  *
  324.  *     Returns: "0" if NOT CNet/4, or "1" if CNet/4 being used.
  325.  */
  326.  
  327. cnet=CHECKVER()
  328. transmit "Version "cnet" of CNet!" ; transmit
  329. cnet=CHECKVER()-3
  330. transmit "Running on CNet/4? "word("No Yes",cnet+1)
  331. exit
  332.  
  333. CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
  334.   return (datatype(a,"n")=1&a>"4.25")+3
  335.  
  336. /**[08]*********************************************************************
  337.  *
  338.  * Description: Check if a user is Suboperator in current subboard.
  339.  *
  340.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  341.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  342.  *
  343.  ***************************************************************************
  344.  *
  345.  *       Needs: The CHECKVER() routine listed above.
  346.  *
  347.  *       Usage: <var>=SUBOP(<id>)
  348.  *
  349.  *       Where: <id>   is the ID number of the user.
  350.  *
  351.  *     Returns: <var>  holds "1" if the user has Subop access, "0" if not.
  352.  *
  353.  *       Notes: Compatible with BOTH 3 and 4 versions of CNet, regardless
  354.  *              of the GU shift between versions. Checks ALL SIX SubOp slots
  355.  *              for the user ID specified.
  356.  */
  357.  
  358. cnet=CHECKVER()-3
  359. getuser 40;if SUBOP(result) then transmit "Subop";else transmit "Not Subop"
  360. exit
  361.  
  362. CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
  363.   return (datatype(a,"n")=1&a>"4.25")+3
  364.  
  365. SUBOP:;subLEN=488;subOFF=96;if cnet then do;subLEN=696;subOFF=274;end
  366.   getuser 1209388;su=result*subLEN+subOFF
  367.   getuser 2401068;so=import(x2c(d2x(result+su,8)),12)
  368.   do a=0 to 5;if Arg(1)=c2d(substr(so,a*2+1,2)) then return 1;end;return 0
  369.  
  370. /**[09]*********************************************************************
  371.  *
  372.  * Description: Checks if MCI is enabled in current subboard.
  373.  *
  374.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  375.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  376.  *
  377.  ***************************************************************************
  378.  *
  379.  *       Needs: The CHECKVER() routine listed above.
  380.  *
  381.  *       Usage: <var>=MCIENA()
  382.  *
  383.  *     Returns: <var>  holds "1" if MCI is enabled, "0" if not.
  384.  */
  385.  
  386. cnet=CHECKVER()-3
  387. if MCIENA() then transmit "MCI enabled in this Subboard"
  388.   else transmit "MCI disabled in this Subboard"
  389. exit
  390.  
  391. CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
  392.   return (datatype(a,"n")=1&a>"4.25")+3
  393.  
  394. MCIENA:;subLEN=488;subOFF=243;if cnet then do;subLEN=696;subOFF=381;end
  395.   getuser 1209388;su=result*subLEN+subOFF
  396.   getuser 2401068;return c2d(import(x2c(d2x(result+su,8)),1))=0
  397.  
  398. /**[10]*********************************************************************
  399.  *
  400.  * Description: Convert from 12/24 hour time format to 12/24/min format.
  401.  *
  402.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  403.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  404.  *
  405.  ***************************************************************************
  406.  *
  407.  *       Usage: <var>=TIM(<value>,<mode>)
  408.  *
  409.  *       Where: <value>  is the getuser time value to convert.
  410.  *              <mode>   is the format to convert to:
  411.  *                       (12=12 Hr., 24=24 Hr., 0=Mins. Since Midnight)
  412.  *
  413.  *     Returns: <var>    holds the converted time value.
  414.  *
  415.  *       Fixed: If an AM time was converted to 24-Hr or Minutes format, the
  416.  *              returned value reflected the PM time instead of the AM time.
  417.  */
  418.  
  419. getuser 1500000 ; tia=result
  420. transmit "Getuser = "tia
  421. transmit "12 hour = "tim(tia,12)
  422. transmit "24 hour = "tim(tia,24)
  423. transmit "Minutes = "tim(tia,0)
  424. exit
  425.  
  426. TIM: procedure;parse arg ti,mo;ti=right(ti,6);select
  427.   when mo=12&verify(ti,"ap","M")~=6 then if left(ti,2)>12 then ti=" "left(ti,2)-12||substr(ti,3,3)"p";else ti=ti"a"
  428.   when mo=24&verify(ti,"ap","M")=6 then ti=left(ti,2)+(12*(right(ti,1)="p"))||substr(ti,3,3)
  429.   otherwise if mo=0 then ti=(left(ti,2)+(verify(ti,"ap","M")=6)*(12*(right(ti,1)="p")))*60+substr(ti,4,2)
  430.   end;return ti
  431.  
  432. /**[11]*********************************************************************
  433.  *
  434.  * Description: External Library Loader
  435.  *
  436.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  437.  *
  438.  ***************************************************************************
  439.  *
  440.  *       Usage: call LOADLIB("<library>")
  441.  *
  442.  *       Where: <library>  is the filename of the external library to load,
  443.  *                         inside of either double or single quotation marks.
  444.  *
  445.  *     Returns: If library exists, it will be loaded, but if an error occurs
  446.  *              during the load, you'll be told this and your file will
  447.  *              immediately be terminated. (This occurs if the stated library
  448.  *              is not located in your LIBS: path.)
  449.  */
  450.  
  451. call LOADLIB("rexxsupport.library")
  452. exit
  453.  
  454. LOADLIB: procedure ; parse arg lib ; if ~exists("libs:"lib) then do
  455.   transmit "Error loading..."lib;bufferflush;exit;end
  456.   addlib(lib,0,-30,0);return
  457.  
  458. /**[12]*********************************************************************
  459.  *
  460.  * Description: View, Enable, Disable or Toggle "Priviledge" Flags.
  461.  *
  462.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  463.  *
  464.  ***************************************************************************
  465.  *
  466.  *       Usage: call PRIV(<mode>,<block>,<priv>,<name>)
  467.  *
  468.  *       Where: <mode>  is the KEYWORD (or first LETTER of KEYWORD)
  469.  *                      of the action to be performed:
  470.  *
  471.  *                      V or VIEW    - Current  Priviledge Setting.
  472.  *                      T or TOGGLE  - Reverse  Current    Setting.
  473.  *                      E or ENABLE  - Turn the Priviledge ON.
  474.  *                      D or DISABLE - Turn the Priviledge OFF.
  475.  *
  476.  *             <block>  is either a "0" for ABIT0 (the first 32 privs),
  477.  *                      or a "1" for ABIT1 (the second 32 priviledges).
  478.  *
  479.  *              <priv>  is the Priviledge Index Number found on the
  480.  *                      GetUser 4.00 List(The Number from 0 to 31).
  481.  *
  482.  *              <name>  is the ID Number, Handle, or Real Name of the
  483.  *                      user to perform the action on, whether they are
  484.  *                      ONLINE or NOT! (Uses CNet's Scratch Buffer!)
  485.  *
  486.  *     Returns: <priv>  holds a "Yes" if user HAS this Priviledge, or
  487.  *                              "No"  if user DOESN'T have Priviledge.
  488.  *                      (Updated AFTER Action Has Taken Place!)
  489.  *
  490.  *            <handle>  of the user action was performed on, even if
  491.  *                      you entered an ID Number as the initial argument!
  492.  *
  493.  *            <status>  will be a "1" if data saved successfully, or
  494.  *                                "0" if there was a problem saving.
  495.  *                      (Note this variable NOT used in VIEW Mode!)
  496.  */
  497.  
  498. call PRIV(View,0,14,Dotoran)
  499.   transmit "   VIEW: Can "handle" Conference? "priv ; transmit
  500. call PRIV(Disable,0,28,David Weeks)
  501.   transmit "DISABLE: "handle" is no longer a SysOp! status="status
  502. call PRIV(V,0,28,1)
  503.   transmit "   VIEW: Is "handle" a SysOp: "priv
  504. call PRIV(Enable,0,28,Dotoran)
  505.   transmit " ENABLE: "handle" is now a SysOp! status="status
  506. call PRIV(View,0,28,1)
  507.   transmit "   VIEW: Is "handle" a SysOp: "priv ; transmit
  508. call PRIV(Vi,1,20,1)
  509.   transmit "   VIEW: Can "handle" Send FIDO NetMail: "priv
  510. call PRIV(Toggle,1,20,1)
  511.   transmit " TOGGLE: Toggled ability to Send FIDO NetMail. status="status
  512. call PRIV(View,1,20,1)
  513.   transmit "   VIEW: Can "handle" Send FIDO NetMail: "priv
  514. exit
  515.  
  516. PRIV: procedure expose priv handle status
  517.   arg mode,block,priv,id;c=left(mode,1)
  518.   if datatype(id,"n")=0 then do;findaccount id;id=result;end
  519.   if id=0 then do;transmit "Invalid Handle! Aborted!";return;end
  520.   loadscratch id;getscratch 1;handle=result
  521.   if handle="!" then do;transmit "Empty Account! Aborted!"
  522.     savescratch (-id);return;end
  523.   getscratch 1401332+block*48;a=reverse(d2c(result,4))
  524.   if c="E" then a=BitSET(a,priv);if c="D" then a=BitCLR(a,priv)
  525.   if c="T" then a=BitCHG(a,priv);priv=word("No Yes",BitTST(a,priv)+1)
  526.   if c="V" then do;savescratch (-id);return;end
  527.   setobject c2d(reverse(a));putscratch 1401332+block*48
  528.   savescratch id;status=result
  529.  return
  530.  
  531. /**[13]*********************************************************************
  532.  *
  533.  * Description: Get "Arguments" from last command.
  534.  *
  535.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  536.  *              PMK             - (Peter no longer runs a bbs...)
  537.  *
  538.  ***************************************************************************
  539.  *
  540.  *       Usage: <var>=ARGS()
  541.  *
  542.  *       Where: <var>    is any legal variable name.
  543.  *
  544.  *     Returns: <var>    holds total number of arguments. (Max of 6)
  545.  *              <arg.0>  holds command text/name.
  546.  *              <arg.1>  holds 1st argument.
  547.  *                  |    thru
  548.  *              <arg.6>  holds 6th argument.
  549.  *
  550.  *      Note 1: Max length of any one argument is 61 characters, and any
  551.  *              unused arguments will contain the null string.
  552.  */
  553.  
  554. total=ARGS() ; transmit "Arguments: "total ; transmit "  Command: "arg.0
  555. do i=1 to total ; transmit "    Arg "i": "arg.i ; end i
  556. exit
  557.  
  558. ARGS: procedure expose arg. ; getuser 1202244
  559.   do i=0 to result ; getuser 1302246+(i*61) ; arg.i=result ; end
  560.  return i-2
  561.  
  562. /**[14]*********************************************************************
  563.  *
  564.  * Description: Read "Cursor Key" / "Return/Enter" Keyboard Input.
  565.  *
  566.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  567.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  568.  *
  569.  ***************************************************************************
  570.  *
  571.  *       Usage: <var> = GETCURSOR()
  572.  *
  573.  *     Returns: <var> will be "8" if UP    arrow was pressed.
  574.  *                    will be "2" if DOWN  arrow was pressed.
  575.  *                    will be "4" if LEFT  arrow was pressed.
  576.  *                    will be "6" if RIGHT arrow was pressed.
  577.  *                    will be "5" if ENTER or RETURN pressed.
  578.  *
  579.  *      Note 1: Returned values are identical to the numeric keypad layout,
  580.  *              so programs using this routine can be accessed by people who
  581.  *              do not have directional cursor keys (A600, C64, etc.)
  582.  *
  583.  *      Note 2: If key pressed was none of the above, then <var> will hold
  584.  *              the actual character that WAS pressed. Returned keys will be
  585.  *              UPPERCASE to mimic the same action as the GETCHAR command.
  586.  */
  587.  
  588. START:;key=GETCURSOR();transmit key;if key~="Q" then signal START;exit
  589.  
  590. GETCURSOR: procedure;do until key~="NOCHAR";maygetchar;key=result;end
  591.   if key="1B"x then do 2;maygetchar;key=result;end;else if key="D"x then return "5";else return upper(key)
  592.   if key="A" then return "8";if key="B" then return "2";if key="C" then return "6";if key="D" then return "4"
  593.  return upper(key)
  594.  
  595. /**[15]*********************************************************************
  596.  *
  597.  * Description: Convert "UPPERCASE" to "lowercase" text.
  598.  *
  599.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  600.  *              PMK             - (Peter no longer runs a bbs...)
  601.  *
  602.  ***************************************************************************
  603.  *
  604.  *       Usage: <var> = LOWER(<text>)
  605.  *
  606.  *       Where: <var>   is any valid variable name.
  607.  *              <text>  holds the text to be converted.
  608.  *
  609.  *     Returns: <var>   contains the converted lowercase text.
  610.  */
  611.  
  612. old="The QUICK Brown fox jumped over the LAZY log!";new=LOWER(old)
  613. transmit "Mixed Text: "old;transmit "Lower Text: "new;exit
  614.  
  615. LOWER:;return translate(ARG(1),xrange("a","z"),xrange("A","Z"))
  616.  
  617. /**[16]*********************************************************************
  618.  *
  619.  * Description: Pauses output for "x" number of seconds the RIGHT way!
  620.  *
  621.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  622.  *              PMK             - (Peter no longer runs a bbs...)
  623.  *
  624.  ***************************************************************************
  625.  *
  626.  *       Usage: call PAUSE(<seconds>)
  627.  *
  628.  *       Where: <seconds>  is the number of seconds to wait.
  629.  *
  630.  *        Note: This routine uses the DELAY() function, located in the
  631.  *              support library "rexxsupport.library". See the included
  632.  *              intro for more info on using this library.
  633.  */
  634.  
  635. transmit "Print this line, now wait 5 seconds..."
  636. call PAUSE(5);transmit "Now print this line!";exit
  637.  
  638. PAUSE:;a=delay(Arg(1)*50);return
  639.  
  640. /**[17]*********************************************************************
  641.  *
  642.  * Description: Checks for "Loss of Carrier" in your Doors!
  643.  *
  644.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  645.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  646.  *
  647.  ***************************************************************************
  648.  *
  649.  *     Usage 1: <var> = CHECK(<result>)
  650.  *
  651.  *     Usage 2: call CHECK
  652.  *
  653.  *       Where: <var>  is any valid variable name.
  654.  *
  655.  *      Note 1: Use [Usage 1] after you INPUT data using these commands:
  656.  *              GETCHAR, RECEIVE, PROMPT, the MCI {i } Command, etc.
  657.  *
  658.  *      Note 2: Use [Usage 2] to simply CHECK for CARRIER. It's a good
  659.  *              idea to use a few of these calls in places where your
  660.  *              program may be doing numerous things WITHOUT the user
  661.  *              having to enter any input.
  662.  */
  663.  
  664. getchar;a=CHECK(result);transmit a;call CHECK;transmit "It still works";exit
  665.  
  666. CHECK:;if ARG() & ARG(1)~="###PANIC" then return ARG(1)
  667.     getcarrier;if result="TRUE" then if ARG() then return ARG(1);else return
  668.  
  669.     /* You may wish to call SAVE DATA routines here, reenable MORE 
  670.        prompts, unmuffle or unhide the port, etc.                   */
  671.  
  672.     logentry "Lost Carrier!!";bufferflush;exit
  673.  
  674. /**[18]*********************************************************************
  675.  *
  676.  * Description: An informative "Error Checking" routine.
  677.  *
  678.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  679.  *
  680.  ***************************************************************************
  681.  *
  682.  *       Usage: To use this routine, place it somewhere near the end of
  683.  *              your program, then at the top of your program, normally
  684.  *              right after your "options results" statement, place this
  685.  *              line of text:
  686.  *
  687.  *              signal on SYNTAX ; signal on ERROR ; signal on IOERR
  688.  *
  689.  *     Returns: When an error is encountered, your program will halt. The
  690.  *              user will be shown the error number and description, as well
  691.  *              as the naame of the file the error occurred in. In addition,
  692.  *              the line number and actual code found ON that line will also
  693.  *              be displayed. Any CTRL-Y or CTRL-Q MCI codes contained ON the
  694.  *              line will be rendered using \ and { for safety's sake. A copy
  695.  *              of this same line will be copied to your "calls" log, or to
  696.  *              an "ARexx_Says" log, if you have one defined.
  697.  *
  698.  *      Note 1: Each line is formatted for 46 characters, the maximum width
  699.  *              stated on line 845 of BBSTEXT for inclusion into the logs.
  700.  *              If you include MCI/ANSI color codes into these lines, then
  701.  *              change the "%-.45s" on line 845 of BBSTEXT to read "%s".
  702.  */
  703.  
  704. signal on SYNTAX ; signal on ERROR ; signal on IOERR
  705.  
  706. average=(10+20+30+40/4     /* Causes the "Unbalanced Parenthesis" error. */
  707. exit
  708.  
  709. SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')';e2='  Line: 'left(sigl,4)'File:'
  710.   getuser 1311992;a=result;getuser 1311960;b=result;c='"'a||b'"';e2=e2' 'c;transmit e1;transmit e2;logentry e1;logentry e2
  711.   e=translate(sourceline(sigl),"\{","");do while e~='';e3='Source: 'left(e,37);transmit e3;logentry e3;e=substr(e,38);end;bufferflush;exit
  712.  
  713. /**[19]*********************************************************************
  714.  *
  715.  * Description: Positions cursor for printing anywhere on the screen.
  716.  *
  717.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  718.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  719.  *
  720.  ***************************************************************************
  721.  *
  722.  *       Usage: <command> AT(<row>,<col>)"<text>"
  723.  *
  724.  *       Where: <command>  could be TRANSMIT, SENDSTRING, QUERY, etc.
  725.  *              <row>      is the row text will print on.
  726.  *              <col>      is the column text will start at.
  727.  *              <text>     is the text to be printed, within quotes.
  728.  *
  729.  *     Returns: will print given text at the given screen position.
  730.  */
  731.  
  732. transmit "f1"
  733. transmit AT(1,1)"Will this work?"AT(10,10)"Hello World"
  734. do i=3 to 13 ; sendstring AT(i,50)"Looped Text; Iteration "i-2 ; end
  735. query AT(15,25)"Press ENTER Now..."
  736. exit
  737.  
  738. AT:;return ""arg(1)";"arg(2)"H"
  739.  
  740. /**[20]*********************************************************************
  741.  *
  742.  * Description: Horizontal Text Scroller Number 1.
  743.  *
  744.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  745.  *
  746.  ***************************************************************************
  747.  *
  748.  *       Usage: call SCROLLER(clr,ro1,co1,ro2,co2,dir,"txt")
  749.  *
  750.  *       Where: <clr>  Clear Screen First? (0=No, 1=Yes)
  751.  *              <ro1>  Row to START scrolling at.
  752.  *              <co1>  Column on "ro1" to START scrolling at.
  753.  *              <ro2>  Row to STOP scrolling at.
  754.  *              <co2>  Column on "ro2" to STOP scrolling at.
  755.  *              <dir>  Scroll Direction: 0=Left, 1=Right, 2=Alternate
  756.  *              <txt>  Text to be Scrolled, inside DOUBLE quotes.
  757.  *
  758.  *     Results: The <txt> line will be scrolled between the two columns
  759.  *              on each ROW individually, starting at "ro1" and ending
  760.  *              at "ro2". You can STOP the Scrolling prematurely by
  761.  *              pressing any key.
  762.  */
  763.  
  764. transmit "f1cf8H"copies("*",44)"18H*61H*18H"copies("*",44)"c9"
  765. call SCROLLER(0,10,20,10,60,2,"CNet Amiga ToolKit, v3.00 Compiled by Dotoran of Frontiers!")
  766. exit
  767.  
  768. SCROLLER: procedure;parse arg clr,ro1,co1,ro2,co2,dir,txt;txt=copies(" ",co2-co1)||txt" ";if clr then cls
  769.   do i=ro1 to ro2;lo=1;in=1;hi=length(txt);if dir=2 then d2=(i/2=i%2);if d2=0 then do;lo=hi;hi=1;in=-1;end
  770.   do j=lo to hi by in;maygetchar;if result~="NOCHAR" then leave i;ch=substr(txt,j,co2-co1);transmit ""i";"co1"H"ch;end j;end i
  771.  return
  772.  
  773. /**[21]*********************************************************************
  774.  *
  775.  * Description: Horizontal Text Scroller Number 2.
  776.  *
  777.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  778.  *
  779.  ***************************************************************************
  780.  *
  781.  *       Usage: call SCROLL(<row>,<"txt">)
  782.  *
  783.  *       Where: <row>   is the Screen Row to be Scrolled.
  784.  *              <"txt"> is the Text  Line to be Scrolled, within quotes.
  785.  *
  786.  *      Note 1: You can use three special characters inside your text
  787.  *              string to affect the SPEED at which the text is shown:
  788.  *
  789.  *              Press ALT-1 (¹) for Fastest Speed.
  790.  *              Press ALT-2 (²) for Medium  Speed.
  791.  *              Press ALT-3 (³) for Slowest Speed.
  792.  *
  793.  *              This routine uses the DELAY() command to create the speeds,
  794.  *              which means the "rexxsupport.library" is also needed.
  795.  *
  796.  *      Note 2: The text string will be scrolled from RIGHT to LEFT,
  797.  *              starting at the right edge of the user's default Line
  798.  *              Length(40,80,etc.) You can abort the scrolling at any
  799.  *              time by pressing any key.
  800.  *
  801.  *      Note 3: An interesting alternate use for this routine is to
  802.  *              scroll the EXISTING text on the screen. To do this,
  803.  *              specify the "row" you wish to Scroll, then use "" as
  804.  *              the Text to Scroll. Nothing NEW will appear on the
  805.  *              screen, but any EXISTING characters ON that row will
  806.  *              be scrolled off the left side of the screen!
  807.  */
  808.  
  809. text="²CNet Amiga ToolKit, v3.00 compiled by >> Dotoran of Frontiers <<                        "
  810. text=text||"³³³³³³³³¹ This is a test of the SCROLL subroutine"
  811. call SCROLL(15,text);exit
  812.  
  813. SCROLL: procedure;parse arg line,text;sp=2;getuser27;ll=result-1
  814.   do a=1 to length(text)+ll;ch=substr(text,a,1);if index("¹²³",ch)>0 then sp=translate(ch,"246","¹²³")
  815.   else sendstring ""line";0HP"line";"ll"H"ch;call delay(sp);maygetchar;if result~="NOCHAR" then leave;end
  816.  return
  817.  
  818. /**[22]*********************************************************************
  819.  *
  820.  * Description: Read the joystick(s) and firebutton(s).
  821.  *
  822.  *   Author(s): Thomas          - Dreamline Amiga BBS       +45 3582-7043
  823.  *              PMK             - (Peter no longer runs a bbs...)
  824.  *
  825.  ***************************************************************************
  826.  *
  827.  *       Usage: <var>=JOY(<joynum>)
  828.  *
  829.  *       Where: <joynum>  is the Joy port (0=Port1, 1=Port2)
  830.  *
  831.  *     Returns: <var>     holds keypad values for directions, "0" if none.
  832.  *                        and value+10 if the firebutton was pressed.
  833.  *
  834.  *      Note 1: This routine will allow the joystick(s) to be used from the
  835.  *              LOCAL port only. It will NOT function from remote.
  836.  *
  837.  *      Note 2: Press your ENTER/RETURN key to exit the example given below.
  838.  */
  839.  
  840. do until key="0d"x ; maygetchar; key=result
  841.   transmit "f1"JOY(1) ; end ; exit
  842.  
  843. JOY: procedure;arg w;a=import(d2c(14675978+w*2,4),2);b=~bittst(import("00BF E001"x,1),6+w)*10
  844.   return x2d(translate(c2x(b2c(bittst(a,8)bittst(a,9)bittst(a,0)bittst(a,1))),"963147","B31EC4"))+b
  845.  
  846. /**[23]*********************************************************************
  847.  *
  848.  * Description: First attempt at MOUSE capability. (95% Complete!)
  849.  *
  850.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  851.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  852.  *
  853.  ***************************************************************************
  854.  *
  855.  *       Usage: <var> = MOUSE(<row>,<col>,<length>)
  856.  *
  857.  *       Where: <var>  is any valid variable name.
  858.  *              <row>  is the ROW the button is located on.
  859.  *              <col>  is the COLUMN the button STARTS at.
  860.  *           <length>  is the LENGTH(in Columns) of this button.
  861.  *
  862.  *     Returns: <var>  will be "1" if the Mouse Button WAS pressed.
  863.  *                     will be "0" is the Mouse Button WASN'T pressed.
  864.  *
  865.  *      Note 1: This routine is lacking the ability to catch when you
  866.  *              "double-click" on a button, and will not ALWAYS catch
  867.  *              when you DO click on a button. If anyone can offer us
  868.  *              a better MOUSE() routine, please send us a copy and
  869.  *              we'll include it in the next version(with your name)!
  870.  *
  871.  *      Note 2: The following example program can also be aborted by
  872.  *              pressing any key, instead of using the mouse.
  873.  */
  874.  
  875. transmit "f1Hz7c4  Press Me  z060Hz6cb  QUIT  z0"
  876. do until b1+b2>0;b1=MOUSE(5,5,12);b2=MOUSE(20,60,8);maygetchar
  877. if result~="NOCHAR" then do;transmit "A Keyboard Key was pressed.";exit;end;end
  878. if b1=1 then transmit "`Press Me' was pressed.";if b2=1 then transmit "`QUIT' was pressed."
  879. exit
  880.  
  881. MOUSE: procedure;getuser 1202140;xc=result%8+1 ; getuser 1202142;yc=(result-11)%8+1
  882.   return arg(1)=yc & xc>=arg(2) & xc<arg(2)+arg(3) & bittst(import("00BF E001"x,1),6)=0
  883.  
  884. /**[24]*********************************************************************
  885.  *
  886.  * Description: Disable or Enable the MORE? prompt, regardless of setting!
  887.  *
  888.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  889.  *
  890.  ***************************************************************************
  891.  *
  892.  *     Usage 1: call NOMORE
  893.  *
  894.  *     Usage 2: call MORE
  895.  *
  896.  *  Before Use: Add this line somewhere at the START of your file, so that
  897.  *              it will only be run ONCE:
  898.  *
  899.  *              getuser 1100454;oldmore=result
  900.  *
  901.  *   After Use: When you're ready to LEAVE your file, place this line BEFORE
  902.  *              every occurrance of the command EXIT:
  903.  *
  904.  *              setobject oldmore;putuser 1100454
  905.  *
  906.  *      Note 1: Use [Usage 1] when you wish to DISABLE the More? Prompt,
  907.  *              Use [Usage 2] when you wish to ENABLE  the More? Prompt.
  908.  *
  909.  *      Note 2: Be sure to add the above two lines to insure the user's
  910.  *              chosen More? setting is returned to it's original setting,
  911.  *              especially within an Error Check routine you may be using!
  912.  */
  913.  
  914. getuser 1100454;oldmore=result
  915. transmit "With the More? Prompt disabled..."
  916. call NOMORE ; sendfile "systext:help/mci"
  917. transmit "Now with More? Prompt enabled..."
  918. call MORE ; sendfile "systext:help/mci"
  919. setobject oldmore;putuser 1100454
  920. exit
  921.  
  922. NOMORE:;sendstring "L1100454 #0}";return
  923. MORE:;sendstring "L1100454 #1}";return
  924.  
  925. /**[25]*********************************************************************
  926.  *
  927.  * Description: Muffle ALL ports, regardless of setting!
  928.  *
  929.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  930.  *
  931.  ***************************************************************************
  932.  *
  933.  *       Usage: call MUFFLE
  934.  *
  935.  *  Before Use: Add this line somewhere at the START of your file, so that
  936.  *              it will only be run ONCE:
  937.  *
  938.  *              getuser 1101745 ; muffle=result ; call MUFFLE
  939.  *
  940.  *   After Use: When you're ready to LEAVE your file, place this line BEFORE
  941.  *              every occurrance of the command EXIT:
  942.  *
  943.  *              if muffle=0 then call MUFFLE
  944.  *
  945.  *      Note 1: Use "call MUFFLE" as a command in your file as well to give
  946.  *              the USER the option of toggling the Muffle Setting.
  947.  *
  948.  *      Note 2: Be sure to add the above two lines to insure the user's
  949.  *              chosen Muffle setting is returned to it's original setting!
  950.  */
  951.  
  952. getuser 1101745;muffle=result;bbscommand "who";call MUFFLE
  953. bbscommand "who";if muffle=0 then call MUFFLE ; bbscommand "who"
  954. exit
  955.  
  956. MUFFLE:;if muffle=0 then bbscommand "MU *";return
  957.  
  958. /**[26]*********************************************************************
  959.  *
  960.  * Description: Extended SelectFile Routine.
  961.  *
  962.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  963.  *
  964.  ***************************************************************************
  965.  *
  966.  *      Usage: var=SELFILE(<file>,<bcost>,<fcost>,<kill>)
  967.  *
  968.  *      Where: <file>   is the file to add to the Select Buffer (incl. Path)
  969.  *             <bcost>  "0" if the byte is FREE, "100" to deduct 1*bytesize
  970.  *                      "150" to deduct 1.5*bytesize etc.
  971.  *             <fcost>  "0" if the file is FREE, "1" for file price of 1
  972.  *                      "2" for file price of 2 etc.
  973.  *             <kill>   "0"=Don't Kill, "1"=Kill when downloaded,
  974.  *                      "2"=Kill when dl/unselect, "3"=Kill when unselected.
  975.  *
  976.  *    Returns: <var>    "0" If selectbuffer is full.
  977.  *                      "1" If selecting was sucessfull.
  978.  */
  979.  
  980. if SELFILE("s:startup-sequence",200,2,0) then transmit "File added to selectbuffer"
  981. else transmit "Sorry - your selectbuffer is full!"
  982. exit
  983.  
  984. SELFILE: procedure;arg np,bco,fco,ki;getuser 1209644;nu=result;getuser 2407246;if nu=result then return 0
  985.   pa=left(np,max(lastpos(":",np),lastpos("/",np)));na=substr(np,length(pa)+1);si=word(statef(np),2)
  986.   sh=x2c(d2x(si,8))left(na,32,"00"x)left(pa,96,"00"x)copies("00"x,7)x2c(d2x(ki,2))x2c(d2x(si*bco%100,8))x2c(d2x(fco,4))copies("00"x,6)copies("FF"x,4)
  987.   getcarrier;if result~="TRUE" then exit;getuser 1401978;call export(x2c(d2x(result+nu*156,8)),sh);setobject nu+1;putuser 1209644;return 1
  988.  
  989. /**[27]*********************************************************************
  990.  *
  991.  * Description: Add line of text to specified LOG file.
  992.  *
  993.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  994.  *
  995.  ***************************************************************************
  996.  *
  997.  *       Usage: call LOG("<name>","<text>","[path]")
  998.  *
  999.  *       Where: <name>  is the NAME of the LOG file to add to.
  1000.  *              <text>  is the TEXT line to be added to the log.
  1001.  *              [path]  if present, this specifies an alternate path to
  1002.  *                      SAVE the LOG to. Defaults to "SysData:Log/"
  1003.  */
  1004.  
  1005. call LOG("test_log","As found in Sysdata:Log/ path.")
  1006. call LOG("test_log","As found in RAM: path!!","ram:")
  1007. sendfile "sysdata:log/test_log" ; sendfile "ram:test_log"
  1008. exit
  1009.  
  1010. LOG: procedure;parse arg n,t,a;if Arg()=2 then a="SysData:Log/";n=a||n
  1011.   call open(f9,n,substr("wa",exists(n)+1,1));call writeln(f9,t)
  1012.   call close(f9);return
  1013.  
  1014. /**[28]*********************************************************************
  1015.  *
  1016.  * Description: Check Port Menu(s) Checkmark Status.
  1017.  *
  1018.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1019.  *              PMK             - (Peter no longer runs a bbs...)
  1020.  *
  1021.  ***************************************************************************
  1022.  *
  1023.  *       Usage: call PMENU(<port>,<item>)
  1024.  *
  1025.  *       Where: <port>  is the PORT to check. (Use 100 for ALL Ports).
  1026.  *              <item>  is the item to check. Although you can type as much
  1027.  *                      of the menu item text as you wish, only the first
  1028.  *                      letter matters, as shown below:
  1029.  *
  1030.  *      For CNet, v3.05c's Routine:         For CNet, v4.26b's Routine:
  1031.  *      ~~~~~~~~~~~~~~~~~~~~~~~~~~~         ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1032.  *      's' to check "Sysop is in".         'd' to check "Doors closed".
  1033.  *      'n' to check "No new users".        'f' to check "Files closed".
  1034.  *      'u' to check "UD base closed".      'm' to check "Msgs closed".
  1035.  *      'p' to check "Pfiles closed".       'n' to check "No new users".
  1036.  *      'b' to check "Base closed".         's' to check "Sysop is in".
  1037.  *
  1038.  *     Returns:  0  if there is NO checkmark shown.
  1039.  *               1  if there IS a  checkmark shown.
  1040.  *
  1041.  *        Note: There are TWO DIFFERENT "PMENU" routines listed below. Not
  1042.  *              only did the GetUser change between versions, but the ORDER
  1043.  *              of the Menu Flags changed as well. Make sure to use the right
  1044.  *              version, depending on your CNet version. If creating a dual
  1045.  *              compatible program, use the CHECKVER() routine above, then
  1046.  *              include BOTH routines given below, perhaps RENAMING them to
  1047.  *              "PMENU3" and "PMENU4", calling the needed routine, based on
  1048.  *              your returned result from CHECKVER().
  1049.  */
  1050.  
  1051. /* Example code for CNet, v4.26b */
  1052.  
  1053. transmit "Menu for Port: 0n1"
  1054. call PMENU(0,d) ; transmit " Doors closed: "word("No Yes",result+1)
  1055. call PMENU(0,f) ; transmit " Files closed: "word("No Yes",result+1)
  1056. call PMENU(0,m) ; transmit "  Msgs closed: "word("No Yes",result+1)
  1057. call PMENU(0,n) ; transmit " No new users: "word("No Yes",result+1)
  1058. call PMENU(0,s) ; transmit "  SysOp is in: "word("No Yes",result+1)
  1059. exit
  1060.  
  1061. PMENU: procedure;arg p,m;m=index("DFMNS",left(m,1))-1
  1062.   getuser 2124552+(p*24);return bittst(d2c(result),m)
  1063.  
  1064. /* Example code for CNet, v3.05c */
  1065.  
  1066. transmit " Menu for Port: 0n1"
  1067. call PMENU(0,s) ; transmit "   SysOp is in: "word("No Yes",result+1)
  1068. call PMENU(0,n) ; transmit "  No new users: "word("No Yes",result+1)
  1069. call PMENU(0,u) ; transmit "UD base closed: "word("No Yes",result+1)
  1070. call PMENU(0,p) ; transmit " Pfiles closed: "word("No Yes",result+1)
  1071. call PMENU(0,b) ; transmit "   Base closed: "word("No Yes",result+1)
  1072. exit
  1073.  
  1074. PMENU: procedure;arg p,m;m=index("SNUPB",left(m,1))-1
  1075.   getuser 2121864+(p*24);return bittst(d2c(result),m)
  1076.  
  1077. /**[29]*********************************************************************
  1078.  *
  1079.  * Description: Send Text File as CNet MAIL to specified User.
  1080.  *
  1081.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1082.  *
  1083.  ***************************************************************************
  1084.  *
  1085.  *       Usage: call MAIL(<id>,"<subj>","<file>")
  1086.  *
  1087.  *       Where: <id>    can be the ID Number, Handle or Real Name of the
  1088.  *                      user in which you'd like to send the mail item to.
  1089.  *                      If a Handle or Real Name is specified, enclose it
  1090.  *                      in double quotation marks.
  1091.  *
  1092.  *              <subj>  is the Subject to name the Mail Message.
  1093.  *
  1094.  *              <file>  if the path/filename of the text file to send.
  1095.  *
  1096.  *     Returns:  0  if mail send FAILED. (File Not Found/Box Closed or Full)
  1097.  *               1  if mail was sent successfully.
  1098.  *
  1099.  *       Notes: The example given below utilizes a text file created using
  1100.  *              the "BUGS" command, a BBSMenu enhancement found in the TEXT
  1101.  *              ToolKit.
  1102.  */
  1103.  
  1104. if MAIL(1,"CNet Bugs","uploads:cnetbugs") then transmit "Mail sent!"
  1105.   else transmit "Mail send failed!"
  1106. exit
  1107.  
  1108. MAIL: procedure;parse arg id,subj,file;findaccount id"!";id=result
  1109.   if ~exists(file) then do;transmit "File not found!";return 0;end
  1110.   loadeditor file;setmailsubj subj;writemail id;return result
  1111.  
  1112. /**[30]*********************************************************************
  1113.  *
  1114.  * Description: Send a CNet/4 "File Attach" EMail Message to specified User.
  1115.  *
  1116.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1117.  *
  1118.  ***************************************************************************
  1119.  *
  1120.  *        Note: This routine ONLY runs under CNet, v4.26b!
  1121.  *
  1122.  *       Usage: call FMAIL(<id>,"<subj>","<text>","<file>")
  1123.  *
  1124.  *       Where: <id>    can be the ID Number, Handle or Real Name of the
  1125.  *                      user in which you'd like to send the mail item to.
  1126.  *                      If a Handle or Real Name is specified, enclose it
  1127.  *                      in double quotation marks.
  1128.  *
  1129.  *              <subj>  is the Subject to name the Mail Message. Enclose in
  1130.  *                      double quotes if subject contains SPACES.
  1131.  *
  1132.  *              <text>  is a text file that will become the BODY of the EMail
  1133.  *                      Message. Enclose the text in double quotes if it will
  1134.  *                      contain SPACES in the filename.
  1135.  *
  1136.  *              <file>  is the path/filename of the text file to attach to
  1137.  *                      the email message created. Again, if the name will
  1138.  *                      contain SPACES, enclose it in double quotes.
  1139.  *
  1140.  *     Returns:  0  if mail FAILED. (Text or File Not Found)
  1141.  *               1  if command string sent successfully.
  1142.  *
  1143.  *       Notes: The example given below utilizes a text file created using
  1144.  *              the "BUGS" command, a BBSMenu enhancement found in the TEXT
  1145.  *              ToolKit. Also, no internal checking is done on whether the
  1146.  *              mail send itself was successful. This routine creates the
  1147.  *              needed command string, which is then sent to CNet's Keyboard
  1148.  *              Buffer. If the user has the VisEd set as their default, then
  1149.  *              the appropriate extra commands are prepended and suffixed to
  1150.  *              the mailsend commands to temporarily switch to the LineEd, so
  1151.  *              the proper dot(.) commands can be executed.
  1152.  */
  1153.  
  1154. if FMAIL(1,"CNet Bugs","dweeks:for_ray","uploads:cnetbugs") then
  1155.   transmit "Mail sent!" ; else transmit "Mail failed!"
  1156. exit
  1157.  
  1158. FMAIL: procedure;parse arg id,subj,text,file;findaccount id"!";id=result
  1159.   if ~exists(text)|~exists(file) then do;transmit "File error!";return 0;end
  1160.   getuser 1100645;ed=result;keys="";if ed then keys="ep`9`0``"
  1161.   keys=keys"ms`"id"```"subj"`F`"file"`.g"text"`.s`"
  1162.   if ed then keys=keys"ep`9`1``";addkeys (keys)
  1163.  return 1
  1164.  
  1165. /**[31]*********************************************************************
  1166.  *
  1167.  * Description: Send a System OLM (OnLine Message) to the current user.
  1168.  *
  1169.  *   Author(s): Dotoran             - Frontiers BBS         +1 716/823-9892
  1170.  *              PMK                 - (Peter no longer runs a bbs...)
  1171.  *
  1172.  ***************************************************************************
  1173.  *
  1174.  *     Inputs: This routine uses the CHECKVER() routine above to define the
  1175.  *             "cv" variable, which the SENDOLM() routine uses. You also need
  1176.  *             to define variables "handle", "port", and "uid" before calling
  1177.  *             this routine.
  1178.  *
  1179.  *             Routine works on BOTH v3.05c and v4.26b of CNet Amiga!
  1180.  *
  1181.  *      Usage: call SYSOLM(<msg>)
  1182.  *
  1183.  *      Where: <msg>  is the Message to appear as a "System OLM", enclosed
  1184.  *                    in double quotation marks.
  1185.  *
  1186.  *     Option: If you wish to add MCI-Commands into your OLM-text, then you
  1187.  *             need to REMOVE the \@1 from the END of line number 920 in your
  1188.  *             BBSTEXT file, so it reads:
  1189.  *
  1190.  *             920:   \n1\c7**** System Message\n1\a1
  1191.  *
  1192.  *             Remember, the \'s are really CONTROL-Y's.
  1193.  *
  1194.  *       Note: The \'s and {'s used in the example given below are actually
  1195.  *             Control-Y's and Control-Q's, used to show the COLORIZED OLM
  1196.  *             ability of this routine. Make the proper substitutions when
  1197.  *             you try this routine on your ends, as well as modifying Line
  1198.  *             920 as stated above.
  1199.  */
  1200.  
  1201. getuser 1 ; handle=result ; getuser 23 ; port=result
  1202. getuser 40 ; uid=result ; cv=CHECKVER()
  1203. call SENDOLM("\c6Hello \ca{V1}\c6, How are you this \cb{V46}\c6?!?")
  1204. exit
  1205.  
  1206. CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
  1207.   return (datatype(a,"n")=1&a>"4.25")+3
  1208.  
  1209. SYSOLM:;parse arg text;getuser 2307346;path=result;z="00"x;a="";v1=""
  1210.   if exists(path"_olm"port) then a="a";name=path"_"a"olm"
  1211.   a="w";t=0;if exists(name) then a="a";if cv=4 then v1=d2c(uid,4)
  1212.   h=v1||left(handle,26,z)copies(z,28)text"0A1A0A"x;n=name||port
  1213.   if cv=3 then h=overlay(d2c(1),h,31,1)
  1214.   call forbid();call open(f1,n,a);call writeln(f1,h);call close(f1)
  1215.   call permit();setobject "0";putuser 1409746
  1216.   getuser 1101743;olm=result+1;setobject olm;putuser 1101743  
  1217.  return
  1218.  
  1219. /**[32]*********************************************************************
  1220.  *
  1221.  * Description: Add keystrokes to other ports from present port.
  1222.  *
  1223.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1224.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1225.  *
  1226.  ***************************************************************************
  1227.  *
  1228.  *       Usage: call ADDEM(<port>,"<keys>",<mode>)
  1229.  *
  1230.  *       Where: <port>  is the port number to add keystrokes to.
  1231.  *              <keys>  are the keystrokes to add, within double quotes.
  1232.  *              <mode>  as "1" and the user will see them,
  1233.  *                      as "2" and the user will NOT see them.
  1234.  *
  1235.  *     Returns: Keystrokes will be entered into the command stream on stated
  1236.  *              port. Nothing will be returned on your port.
  1237.  *
  1238.  *    Example1: call ADDEM(2,"o!",2) will LogOff user on Port 2 without them
  1239.  *                                   knowing what just happened!
  1240.  *
  1241.  *    Example2: call ADDEM(1,"ep;9;1;;",1) will set the Visual Editor as the
  1242.  *                                         default editor for user on Port 1
  1243.  *                                         allowing them to see the command
  1244.  *                                         being processed on their screens!
  1245.  *
  1246.  *       Notes: The serial port is DISABLED when you choose for the user NOT
  1247.  *              to be able to see what commands you just entered. For this
  1248.  *              reason, YOU on the LOCAL port WILL see the commands being
  1249.  *              executed, however the text output is NOT sent over the serial
  1250.  *              port.
  1251.  */
  1252.  
  1253. query "  Send to which port? ";port=result
  1254. query "Add which keystrokes? ";keys=result
  1255. sendstring " Disable serial port? ";getchar;a=result
  1256. if a="Y" then mode=2;else mode=1;transmit word("No Yes",mode)
  1257.  
  1258. call ADDEM(port,keys,mode)
  1259. exit
  1260.  
  1261. ADDEM: procedure;parse arg po,ke,mo;address ("CNETREXX"po)
  1262.   modem mo;addkeys ke"`";modem 1;return
  1263.  
  1264. /**[33]*********************************************************************
  1265.  *
  1266.  * Description: A QUICK "Who" for SysOps, listing Access Group Number.
  1267.  *
  1268.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1269.  *              Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1270.  ***************************************************************************
  1271.  *
  1272.  *      Inputs: The CHECKVER() routine is used to create 3.05c/4.26b CNet
  1273.  *              compatibility.
  1274.  *
  1275.  *       Usage: call WHO
  1276.  *
  1277.  *     Returns: Displays all loaded ports, listing port number, handle,
  1278.  *              access group, speed, from and where info.
  1279.  */
  1280.  
  1281. cnet=CHECKVER()-3
  1282. call WHO
  1283. exit
  1284.  
  1285. CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
  1286.   return (datatype(a,"n")=1&a>"4.25")+3
  1287.  
  1288. WHO:;transmit "r1#  "left("Handle",21)left("AG SPD From",38)left("Location",16)"r0"
  1289.   getuser word("2225094 2227782",cnet+1);hp=result;do po=0 to hp;getportid po;pi=result;if pi=-1 then iterate
  1290.   loadscratch pi;savescratch (-pi);getscratch 1;ha=result;getscratch 15;ac=result;getwhere po;wh=result;getscratch 1201214;cp=result%10
  1291.   getscratch 4;fr=result;transmit left(po,3)left(ha,21)left(ac,3)left(cp,4)left(fr,31)left(wh,16);end
  1292.  return
  1293.  
  1294. /**[34]*********************************************************************
  1295.  *
  1296.  * Description: View "port" log of specified port. (Pre "calls" log).
  1297.  *
  1298.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1299.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1300.  *
  1301.  ***************************************************************************
  1302.  *
  1303.  *       Usage: call LOGPO(<port>)
  1304.  *
  1305.  *       Where: <port>  is the port number to view the log of.
  1306.  *
  1307.  *     Returns: Displays the "calls" log entry for this user, as it looks
  1308.  *              so far. By activating other log processes through CONFIG
  1309.  *              without assigning other log names for them, you can see
  1310.  *              what the user has done up to that point this call.
  1311.  */
  1312.  
  1313. query "Port to view log of? ";po=result;call LOGPO(po);exit
  1314.  
  1315. LOGPO: procedure;arg p;if exists("sysdata:log/port"p) then sendfile "sysdata:log/port"p
  1316.   else transmit "Port "p" log not found.";return
  1317.  
  1318. /**[35]*********************************************************************
  1319.  *
  1320.  * Description: Send Line Noise to a port (Ability to kick them off too!)
  1321.  *
  1322.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1323.  *              Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1324.  *
  1325.  ***************************************************************************
  1326.  *
  1327.  *      Inputs: Define a "cv" variable by calling the CHECKVER() routine to
  1328.  *              determine the correct CNet Version!
  1329.  *
  1330.  *       Usage: call LNOISE(<port>,<drop>)
  1331.  *
  1332.  *       Where: <port>  is the port number to send Line Noise to.
  1333.  *              <drop>  as "1" will also DROP CARRIER on that port,
  1334.  *                      as "0" will NOT drop carrier. Just Annoy! hehe
  1335.  *
  1336.  *     Returns: A check is done to make sure that the user using this routine
  1337.  *              is a Conference Controller and that the port number entered
  1338.  *              is a valid number. A check is also done to make sure the
  1339.  *              user issuing the Line Noise doesn't lose carrier themselves.
  1340.  */
  1341.  
  1342. query "Send Line Noise to which Port? ";port=result
  1343. sendstring "Should  it  also Drop Carrier? ";getchar;a=result
  1344. if a="Y" then drop=1;else drop=0;transmit word("No Yes",drop+1)
  1345. cv=CHECKVER()-3 ; call LNOISE(port,drop)
  1346. exit
  1347.  
  1348. CHECKVER:;bbsidentify bbs;a=left(word(result,3),4)
  1349.   return (datatype(a,"n")=1&a>"4.25")+3
  1350.  
  1351. LNOISE:;arg p,d;a=time("s");getuser 1400660;if bittst(reverse(d2c(result,4)),15)=0 then exit
  1352.   if p="###PANIC" then exit;getuser word("2225094 2227782",cv+1);hp=result;if p>hp|p<0|datatype(p,"n")=0 then exit
  1353.   a.0=d2c(6)"s1ou‡†797¾’s0†7’†™i7";a.1=d2c(6)"‰¾";a.2=d2c(6)"«¾’†«¾’"d2c(6)"y‰”’†«¾”®«¾7r"
  1354.   a.3="®6¾½¤80y9ohj;"d2c(12)";";a.4=d2c(13)":OJl•Š;;ø·";a.5=d2c(12)d2c(8)"¡¾½¼©w1µþð65™…®ð7"
  1355.   a.6="54®©       †„7    08o  7pi"d2c(8)"‹­·¡";a.7="¾µ¤ˆP*o¡¤þ·ž7ue64s¼¢³ž”…G";a.8="DXc  ."d2c(11)"LJ. Š;o8"
  1356.   a.9="n"d2c(12)"¡¾½#©ð™”¢’e";a.10="¾ž¼43…5"d2c(4)"i6yYth98h¤«‰yˆ)*Ou"d2c(7)"9i76y"
  1357.   a.11=d2c(6)"¡¾½f«¾s1¼®®«¾5»·y9i-»«•s0098þ·žr·ž«¾†‰«¾‰”«¾¡";a.12="utg97‰•”‡97”•‹n1"d2c(2)"‰¾þ‰•"
  1358.   a.13="T«¡¾þ®†Š™hgb¸–ºmnª­º vh,"d2c(13)"v­bvÇn";a.14=d2c(2)" c ‚Vƒ˜‚šxgedy";a.15="trd¡¤‹†w1ˆ¡µðµþðç        "d2c(4)"dd"
  1359.   a.16=""d2c(4)"½þµð•n1"d2c(4)"þµð•”„";a.17="¤þ¡µðiy"d2c(6)""d2c(6)d2c(6)"‰™†"d2c(6)"ð";a.18=d2c(6)d2c(4)d2c(6)"uy"d2c(7)
  1360.   address ("CNETREXX"p);do random(4,18);l=random(0,18);sendstring a.l;end
  1361.   if d=1 then dropcarrier;do random(4,18);l=random(0,18);sendstring a.l;end
  1362.   bufferflush;return
  1363.  
  1364. /**[36]*********************************************************************
  1365.  *
  1366.  * Description: UnLock User Accounts (That May NOT Have Been Previously!)
  1367.  *
  1368.  *   Author(s): Aunt Bea        - Blue Moon BBS             +1 716/871-9866
  1369.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1370.  *
  1371.  ***************************************************************************
  1372.  *
  1373.  *       Usage: call UNLOCK(<id>)
  1374.  *
  1375.  *       Where: <id>  is the ID number of the account to UnLock. This can
  1376.  *                    also be specified as the Handle or Real Name of the
  1377.  *                    user whose account you wish unlocked. Use "0" to
  1378.  *                    UnLock ALL accounts on your system.
  1379.  *
  1380.  *     Returns: Will tell you when it's done.
  1381.  *
  1382.  *    WARNING!: You should ONLY run this file when there are NO OTHER ARexx
  1383.  *              tasks running simultaneously, as if one of these other tasks
  1384.  *              were to LOCK an account, Unlocking it prematurely may cause
  1385.  *              THAT task to fail or crash. This routine is meant as a FIX
  1386.  *              for any files using LOADSCRATCH where you believe there to
  1387.  *              be a problem with it not UNLOCKING the accounts.
  1388.  */
  1389.  
  1390. query "Account to UnLock? [0=ALL]: ";p=result;call UNLOCK(p);exit
  1391.  
  1392. UNLOCK: procedure;arg p;getuser 2400088;ta=result;if p=0 then do i=1 to ta;savescratch (-i);sendstring ".";end i
  1393.   else do;findaccount p;id=result;savescratch (-id);end;transmit "Account(s) unlocked.";return
  1394.  
  1395. /**[37]*********************************************************************
  1396.  *
  1397.  * Description: Replace <input> with <output> within string of <text>.
  1398.  *              (A bit like the AREXX's TRANSLATE command, but NOT limited
  1399.  *               to replacing text of equal length)
  1400.  *
  1401.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  1402.  *
  1403.  ***************************************************************************
  1404.  *
  1405.  *       Usage: <var>=REPLACE(<text>,<input>,<output>)
  1406.  *
  1407.  *       Where: <text>    holds the text to do replacement on.
  1408.  *              <input>   is the text you want to replace.
  1409.  *              <output>  is the text you want to appear instead of <input>.
  1410.  *
  1411.  *     Returns: <var>     holds the replaced <text>.
  1412.  */
  1413.  
  1414. text="My handle is PMK, and this is a test!! - PMK!!"
  1415. transmit "n1Before replace: "text ; getuser 1 ; handle=result
  1416. transmit "n1 After replace: "REPLACE(text,"PMK",handle)
  1417. exit
  1418.  
  1419. REPLACE: procedure;parse arg a,b,c;d=index(a,b);do while d~=0
  1420.   a=insert(c,delstr(a,d,length(b)),d-1);d=index(a,b);end;return a
  1421.  
  1422. /**[38]*********************************************************************
  1423.  *
  1424.  * Description: Find and Return or Verify BBSMENU Line(s).
  1425.  *
  1426.  *   Author(s): Dotoran         - Frontiers BBS             +1 716/823-9892
  1427.  *              PMK             - (Peter no longer runs a bbs...)
  1428.  *
  1429.  ***************************************************************************
  1430.  *
  1431.  *       Usage: <var>=BMTXT(<menu>,[<line>])
  1432.  *
  1433.  *       Where: <menu>  BBSMENU Menu Number.
  1434.  *              <line>  Line Number in Menu OR command to Verify.
  1435.  *
  1436.  *     Returns: <var>   when <line> is NUMERIC, holds the returned BBSMENU 
  1437.  *                      Menu Line entry. If <line> is text, a "1" is returned
  1438.  *                      if a command by that name exists in that menu. ("0"
  1439.  *                      is returned if no such command exists. If <line> is
  1440.  *                      omitted, the number of lines in that BBSMENU Menu are
  1441.  *                      returned in <var>, while the "BMT.<x>" array will hold
  1442.  *                      the actual BBSMENU listing.
  1443.  */
  1444.  
  1445. transmit "Menu #  7, Item 6: "BMTXT(7,6)
  1446. transmit "Menu # 12, Item 3: "BMTXT(12,3)
  1447. transmit "Menu # 30, Item 8: "BMTXT(30,8)
  1448. transmit "Menu #  2,  Help?: "word("Yes No",(BMTXT(2,"Help")>1)+1)
  1449. transmit "Menu #  2,  Vote?: "word("Yes No",(BMTXT(2,"Vote")>1)+1)
  1450. transmit "n1Complete Menu # 8: n1"
  1451. do d=0 to BMTXT(8);transmit right(d,3)") "bmt.d;end d;exit
  1452.  
  1453. BMTXT: procedure expose bmt.;b=ARG(1)*2;dt=datatype(ARG(2),"N");getuser 2401064
  1454.   t=import(x2c(d2x(result,8)),220);parse var t 13 p +4 =b+21 s +2 =b+121 l +2
  1455.   if ARG()=2&ARG(2)<=c2d(l)&dt then do;m=import(import(offset(p,4*(c2d(s)+ARG(2))),4),512)
  1456.     parse var m t"00"x;return translate(t,"\{","");end;c=0
  1457.   do a=c2d(s) to (c2d(s)+c2d(l)-1);m=import(import(offset(p,4*a),4),512)
  1458.     parse var m t"00"x;bmt.c=translate(t,"\{","")
  1459.     if ~dt & index(upper(bmt.c),upper(ARG(2)))~=0 then return 1
  1460.     c=c+1;end;return c-1
  1461.  
  1462. /**[39]*********************************************************************
  1463.  *
  1464.  * Description: Clears a specific port, by dumping the user. Similar to
  1465.  *              the DROPCARRIER command, but allows different log entries.
  1466.  *
  1467.  *   Author(s): PMK             - (Peter no longer runs a bbs...)
  1468.  *              Dotoran         - Frontiers BBS             +1 716/823-9892
  1469.  *
  1470.  ***************************************************************************
  1471.  *
  1472.  *       Usage: call DUMPUSER(<port>,<logoff>,[<quick>])
  1473.  *
  1474.  *       Where: <port>    is the port number to clear. (dumps user)
  1475.  *              <logoff>  as  "0" shows "TIME LIMIT EXCEEDED" in the log.
  1476.  *                        as  "1" shows "AUTO CALL-BACK FAILED" in the log.
  1477.  *                        as  "2" shows "IDLE TIME EXCEEDED" in the log.
  1478.  *                        as  "3" shows "LOST CARRIER" in the log.
  1479.  *                        as  "4" shows "INSTANT LOGOFF" in the log.
  1480.  *                        as  "5" shows "NORMAL LOGOFF" in the log.
  1481.  *                        as  "6" shows "RE-LOGON" in the log.
  1482.  *                        as  "7" shows "$ BALANCE TOO LOW" in the log.
  1483.  *                        as  "8" shows "DUMPED BY SYSOP" in the log.
  1484.  *                        as  "9" shows "FILE XFER AUTO-LOGOFF" in the log.
  1485.  *                        as "10" shows "MCI % COMMAND" in the log.
  1486.  *                        as "11" shows "TERM LINK" in the log.
  1487.  *              <quick>   if "1", a quick logoff is performed. (similar to
  1488.  *                        the normal "O!" - No SYS.END is displayed.)
  1489.  *
  1490.  *       Notes: A check is done to make sure that the port number entered
  1491.  *              is a valid number, and the port is occupied by a user.
  1492.  *
  1493.  *              If a type "6", RE-LOGON, is specified, the user will LogOff,
  1494.  *              and then BACK on, using Re-Logon, EVEN if the user does NOT
  1495.  *              have the "RELOGON" priviledge flag set! (kinda cool!)
  1496.  *
  1497.  *     Returns: "0" if the dumping failed (no user on port, bad port etc.)
  1498.  *              "1" if the user was successfully dumped.
  1499.  */
  1500.  
  1501. call dumpuser(0,3)   /* Dump Port 0, due to "LOST CARRIER" in the log! */
  1502.  
  1503. /* <or> */
  1504.  
  1505. call dumpuser(2,6,1) /* Dump Port 2 initiating a "RE-LOGON" process!   */
  1506. exit
  1507.  
  1508. DUMPUSER:procedure;arg p,d,q;if q~=1 then q=0;rl="";if d=6 then rl="L1109806 #2}"
  1509.   getportid p;if result=-1|~datatype(p,"W")|~datatype(d,"W")|d<0|d>11 then return 0
  1510.   address ("CNETREXX"p);sendstring "L1109799 #"q"}L1200022 #"d"}"rl"L1109807 #1}";addkeys "`";return 1
  1511.  
  1512. /**[40]*********************************************************************
  1513.  *
  1514.  * Description: EnCode & DeCode text strings, using a Numeric Key. Given the
  1515.  *              desired text string, along with a numeric key, the text will
  1516.  *              be encoded using a specific code string. The text can then
  1517.  *              only be decoded using the same numeric key.
  1518.  *
  1519.  *   Author(s): Dotoran         - Frontiers BBS             +716 823-9892
  1520.  *
  1521.  ***************************************************************************
  1522.  *
  1523.  *       Usage: To EnCode a text string, use the ENCODE() function:
  1524.  *
  1525.  *              <var> = ENCODE( <text> , <key> )
  1526.  *
  1527.  *       Where: <var>  is the variable the encoded text will be placed.
  1528.  *              <text> is the text string(or variable holding text string)
  1529.  *                     that needs to be encoded.
  1530.  *              <key>  is a numeric value between 1 and 94. Values below 1
  1531.  *                     or greater than 94 will return INCORRECT results!
  1532.  *
  1533.  *       Usage: To DeCode a coded text string, use the DECODE() function:
  1534.  *
  1535.  *              <var> = DECODE( <text> , <key> )
  1536.  *
  1537.  *       Where: <var>  is the variable the decoded text will be stored in.
  1538.  *              <text> is the ALREADY CODED text string you wish to DeCode.
  1539.  *                     This can also be a variable containing coded text.
  1540.  *              <key>  is the SAME numeric key you used to MAKE the initial
  1541.  *                     coded string. If you do NOT use the SAME numeric key,
  1542.  *                     then the text will NOT be DeCoded correctly.
  1543.  *
  1544.  *       Notes: This technique comes in real handy when you wish to encrypt
  1545.  *              data before saving it to disk. The data can then be decoded
  1546.  *              as it is read in the next time it is needed.
  1547.  */
  1548.  
  1549. query "   Enter the text to Encode: ";a=result
  1550. query "Key value(between 1 and 94): ";k=result
  1551. y=ENCODE(a,k);z=DECODE(y,k);transmit
  1552. transmit "Entered Text: "a
  1553. transmit "EnCoded Text: "y
  1554. transmit "DeCoded Text: "z
  1555. exit
  1556.  
  1557. ENCODE:procedure;parse arg t,k;a=xrange(" ","~")
  1558.   k=xrange(d2c(32+k),"~")xrange(" ",d2c(31+k));return translate(t,a,k)
  1559. DECODE:procedure;parse arg t,k;a=xrange(" ","~")
  1560.   k=xrange(d2c(32+k),"~")xrange(" ",d2c(31+k));return translate(t,k,a)
  1561.  
  1562. /**[41]*********************************************************************
  1563.  *
  1564.  * Description: Guideline Entry-text for Mail (and File) Subboards.
  1565.  *              This will display a small bar, with some of the current
  1566.  *              subboard settings, like Sigs allowed?, Handles allowed?,
  1567.  *              Subboard Inactivity days. - Add it to your entry texts.
  1568.  *
  1569.  * Screenshots: Guidelines4BEV1.iff and Guidelines4BEV2.iff
  1570.  *
  1571.  *   Author(s): Dotoran         - Frontiers BBS             +716 823-9892
  1572.  *
  1573.  ***************************************************************************
  1574.  *
  1575.  *       Usage: There are three versions of the Guideline file for BOTH CNet
  1576.  *              versions, an Ascii, ANSI, and IBM-ANSI Beveled. Choose the
  1577.  *              version you wish to use, then use it's filename in place of
  1578.  *              the <guidelines> tag used in the lines below.
  1579.  *
  1580.  *  These stand alone ARexx files can be used in one of two ways:
  1581.  *
  1582.  *  1. You can launch them from within a base's "sys.entry" file by doing
  1583.  *     the following:
  1584.  *
  1585.  *          - Enter the base in question, then type ENTRY.
  1586.  *          - Once in the "sys.entry" editor, type the following line:
  1587.  *
  1588.  *                  {#0<path><guidelines>}
  1589.  *
  1590.  *            Where: <path>         is the location you chose to STORE the 
  1591.  *                                  ARexx Base Guidelines file.
  1592.  *
  1593.  *                   <guidelines>   is the filename of the Base Guidelines
  1594.  *                                  you'd like to use.
  1595.  *
  1596.  *          - Save the editor and you're done. You can create additional
  1597.  *            "sys.entry" files for additional bases.
  1598.  *
  1599.  *  2. Add the following code to the BEGINNING of Line 316 in BBSText:
  1600.  *
  1601.  *              {#0<path><guidelines>}
  1602.  *
  1603.  *     So the completed line looks like this:
  1604.  *
  1605.  *              {#0<path><guidelines>\n1\c7*Subboard \c6(\c7{v48}\c6     <--
  1606.  *              ) \c7{v49}\n1\q1
  1607.  *
  1608.  *     This method will display the selected Guidelines upon entry into
  1609.  *     EVERY base created on your system.
  1610.  *
  1611.  *     Options: Method 1 above offers another advantage over method 2, as
  1612.  *              you also have the ability of specifying alternate Guideline
  1613.  *              designs in different bases. (For instance, perhaps you'd
  1614.  *              like to use the ASCII version in bases that would be more
  1615.  *              frequented by users that can't support IBM-ANSI graphics,
  1616.  *              and use the IBM-ANSI in areas where users CAN support them).
  1617.  *              Additionally, using method 1 allows you NOT to use Guidelines
  1618.  *              in certain OTHER areas as well.
  1619.  *              
  1620.  *              Method 2 offers it's own advantages. The most noticable being
  1621.  *              the fact that you only need to modify ONE file(your bbstext),
  1622.  *              instead of having to create numerous "sys.entry" files. The
  1623.  *              other major advantage is that the Guidelines will be shown to
  1624.  *              EVERY user, regardless of their Help Level setting, whereas
  1625.  *              in Method 1, the Guidelines are ONLY shown to those users of
  1626.  *              the "Novice" Help Level.
  1627.  */
  1628.  
  1629. /* Look for the following files, which should have been included in the 
  1630.    CNet Amiga ToolKit, v3.00 archive:
  1631.  
  1632.    Guidelines3_ASC - Ascii version for CNet, v3.05c.
  1633.    Guidelines3_ANS - Ansi  version for CNet, v3.05c.
  1634.    Guidelines3_BEV - IBM-ANSI (Beveled) version for CNet, v3.05c.
  1635.  
  1636.    Guidelines4_ASC - Ascii version for CNet, v4.26b.
  1637.    Guidelines4_ANS - Ansi  version for CNet, v4.26b.
  1638.    Guidelines4_BEV - IBM-ANSI (Beveled) version for CNet, v4.26b.
  1639.  
  1640. */
  1641.  
  1642. /**[42]*********************************************************************
  1643.  *
  1644.  * Description: NewDoor starter framework for New ARexx Doors/Pfiles.
  1645.  *              (This is similar to the "empty.c" file "C" coders have)
  1646.  *
  1647.  *   Author(s): Dotoran         - Frontiers BBS             +716 823-9892
  1648.  *
  1649.  ***************************************************************************
  1650.  *
  1651.  *       Usage: Included in the CNet Amiga ToolKit, v3.00 is a file titled
  1652.  *              "NewDoor". This file can be used by ARexx programmers as
  1653.  *              a starting framework for NEW projects. Below is a descriptive
  1654.  *              breakdown of the lines found IN that file, so you'll know
  1655.  *              exactly what each line is there for! Lines starting with [>
  1656.  *              are comments by me, and are NOT part of the NewDoor file!
  1657.  */
  1658.  
  1659. -- NewDoor STARTS Here --
  1660.  
  1661. /**************************************************************************\
  1662.     $VER: , v. (--97) by SysOp of BBS!
  1663. \**************************************************************************/
  1664.  
  1665. [> The $VER line allows you to create a VERSION string for your program. You
  1666. [> should place the NAME of your file BEFORE the comma above. Put the version
  1667. [> number after the "v", and it's creation date in DD-MMM-YY format within
  1668. [> the paries (Using DD-MMM-YY format eliminates confusion between different
  1669. [> date formats, like DD-MM-YY (USA), MM-DD-YY (Europe), etc.) Replace SysOp
  1670. [> with the Handle or Real Name of the author, and replace BBS with the name
  1671. [> of the BBS this file was either created on/for, or where the file can be
  1672. [> located for download(in the event the author doesn't run a BBS).
  1673.  
  1674. options results;signal on SYNTAX;signal on ERROR;signal on IOERR
  1675.  
  1676. [> Standard initial ARexx stuff. Nothing major here. ;-)
  1677.  
  1678. a=sourceline(2);parse var a . ", "ver" ("vdate")" .;a=random(,,time("s"))
  1679.  
  1680. [> This line creates two variables, "ver" and "vdate". The "ver" variable
  1681. [> will contain the VERSION number of the program (like v1.00 or v3.42), and
  1682. [> "vdate" will contain the file's creation date (like 10-May-97). You can
  1683. [> then USE these variables throughout the program whenever you wish this
  1684. [> information displayed to the screen. (This line grabs it's info directly
  1685. [> from the $VERsion string, so make sure to follow the correct format, as
  1686. [> described above). This line also seeds the random number generator, so as
  1687. [> to insure a good randomity to any random numbers your file may be using.
  1688. [> If your file will NOT be using the RANDOM() function, you can DELETE the
  1689. [> code that states:    ;a=random(,,time("s"))
  1690.  
  1691. tr=transmit;se=sendstring;gc=getchar;gu=getuser;gs=getscratch;mg=maygetchar
  1692.  
  1693. [> I've used these before, and will mention them again. This line creates a
  1694. [> series of command aliases, or abbreviations, you can choose to use within
  1695. [> your program INSTEAD of using the entire command itself. For instance, the
  1696. [> following line would be valid:    se "Want to continue? [Yes]: ";gc
  1697.  
  1698. [> Again, once your program is complete, you can DELETE any abbreviations you
  1699. [> may not have used in your program. Other aliases I've used include these:
  1700. [> pu=putuser ; ps=putscratch ; qu=query ; pr=prompt
  1701.  
  1702. a="rexxsupport.library";if ~show("l",a) then if ~addlib(a,0,-30) then exit
  1703.  
  1704. [> This line insures the ARexx Support library is available for use. This
  1705. [> line is not necessary if your program does not use any of the Support
  1706. [> functions: ALLOCMEM(), CLOSEPORT(), FREEMEM(), GETARG(), GETPKT(),
  1707. [> OPENPORT(), REPLY(), SHOWDIR(), SHOWLIST(), STATEF(), or WAITPKT().
  1708.  
  1709. parse source . . fp .;df=left(fp,max(lastpos('/',fp),lastpos(':',fp)))
  1710.  
  1711. [> This line creates the "fp" and "df" variables, for use with the Smart Home
  1712. [> Path technique for locating the programs origination path. In "fp", you'll
  1713. [> be given the ENTIRE "FilePath" to the program in question, while "df" will
  1714. [> return ONLY the PATH of the program. For instance, if the "NewDoor" file
  1715. [> was stored in "DOORS:", fp="doors:newdoor", while df="doors:". These two
  1716. [> variables, especially the "df" one, come in REAL handy when you'd like the
  1717. [> program to be able to find an included config or data file that resides in
  1718. [> the SAME directory as the parent file. This line allows the SysOp using
  1719. [> your program to be able to STORE the file ANYWHERE on their systems, and
  1720. [> it will be able to find it's support files (provided the SysOp remembers
  1721. [> to keep ALL the files TOGETHER).
  1722.  
  1723.  
  1724.  
  1725.  
  1726. [> The open GAP in the program is where YOU would include YOUR ARexx coding.
  1727.  
  1728. exit
  1729.  
  1730. [> As a safety measure, the "exit" insures that whatever code comes BEFORE
  1731. [> it doesn't mistakenly run into the Carrier Check routine below.
  1732.  
  1733. CHECK:;if ARG() & ARG(1)~="###PANIC" then return ARG(1)
  1734.   getcarrier;if result="TRUE" then if ARG() then return ARG(1);else return
  1735.   logentry "Lost Carrier!!";bufferflush;exit
  1736.  
  1737. [> This is a "Loss of Carrier" check. Check the Rexx ToolKit for more info
  1738. [> on it's correct usage.
  1739.  
  1740. SYNTAX:;ERROR:;IOERR:;e1="n1 Error: "rc" ("errortext(rc)")"
  1741.   e2="  Line: "left(sigl,4)"File:";c="`"fp", "ver"'";e2=e2" "c;tr e1;tr e2
  1742.   logentry e1;logentry e2;e=strip(translate(sourceline(sigl),"\{",""))
  1743.   do while e~="";e3="Source: "left(e,37);tr e3;logentry e3;e=substr(e,38);end
  1744.   bufferflush
  1745.  
  1746. [> This is a modified version Error Check routine that has been customized
  1747. [> for use within the "NewDoor" file. It utilizes the "fp" variable defined
  1748. [> at the START of this file to include the NAME of the file. It also uses
  1749. [> the "ver" variable, also defined above, to include the VERSION NUMBER of
  1750. [> the program in the returned error message. Note that the "tr" command
  1751. [> alias has also been used in this routine. This alias was defined above
  1752. [> as well. The returned Error Message contains the same information as the 
  1753. [> original routine, described earlier in this document, under the "Error 
  1754. [> Checking Routine".
  1755.  
  1756. [> Please REMEMBER that the above routine is CUSTOMIZED for use INSIDE this
  1757. [> ARexx program. Do NOT copy and paste this routine into other ARexx files,
  1758. [> unless you'll also be using the new header info as well, else the routine
  1759. [> will NOT function correctly. In fact, it'd be rather ironic to have an
  1760. [> Error CHECKING routine that had an ERROR in it ITSELF! hehe ;-)
  1761.  
  1762. /**************************************************************************\
  1763. \*********************************************** Your BBS (AAA)/PPP-SSSS **/
  1764.  
  1765. [> To finish up, this comment line serves two purposes. It tells the reader
  1766. [> they've reached the end of the code, as well as giving the PHONE NUMBER
  1767. [> of the Support BBS they should contact in the event any Bugs are found!
  1768.  
  1769. -- NewDoor ENDS Here --
  1770.  
  1771. ****************************************************************************
  1772. Contributing Authors:
  1773.  
  1774.         Dotoran                 - Frontiers BBS             +1 716/823-9892
  1775.         PMK                     - (Peter no longer runs a bbs...)
  1776.         Aunt Bea                - Blue Moon BBS             +1 716/871-9866
  1777.         Thomas                  - Dreamline Amiga BBS       +45 3582-7043
  1778.         Bill Beogelein          - Amiga SWHQ                +1 810/473-2020
  1779.